home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / os2 / octa209s.zip / octave-2.09 / libcruft / lapack / dgetrs.f < prev    next >
Text File  |  1996-07-19  |  4KB  |  151 lines
  1.       SUBROUTINE DGETRS( TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
  2. *
  3. *  -- LAPACK routine (version 2.0) --
  4. *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
  5. *     Courant Institute, Argonne National Lab, and Rice University
  6. *     March 31, 1993
  7. *
  8. *     .. Scalar Arguments ..
  9.       CHARACTER          TRANS
  10.       INTEGER            INFO, LDA, LDB, N, NRHS
  11. *     ..
  12. *     .. Array Arguments ..
  13.       INTEGER            IPIV( * )
  14.       DOUBLE PRECISION   A( LDA, * ), B( LDB, * )
  15. *     ..
  16. *
  17. *  Purpose
  18. *  =======
  19. *
  20. *  DGETRS solves a system of linear equations
  21. *     A * X = B  or  A' * X = B
  22. *  with a general N-by-N matrix A using the LU factorization computed
  23. *  by DGETRF.
  24. *
  25. *  Arguments
  26. *  =========
  27. *
  28. *  TRANS   (input) CHARACTER*1
  29. *          Specifies the form of the system of equations:
  30. *          = 'N':  A * X = B  (No transpose)
  31. *          = 'T':  A'* X = B  (Transpose)
  32. *          = 'C':  A'* X = B  (Conjugate transpose = Transpose)
  33. *
  34. *  N       (input) INTEGER
  35. *          The order of the matrix A.  N >= 0.
  36. *
  37. *  NRHS    (input) INTEGER
  38. *          The number of right hand sides, i.e., the number of columns
  39. *          of the matrix B.  NRHS >= 0.
  40. *
  41. *  A       (input) DOUBLE PRECISION array, dimension (LDA,N)
  42. *          The factors L and U from the factorization A = P*L*U
  43. *          as computed by DGETRF.
  44. *
  45. *  LDA     (input) INTEGER
  46. *          The leading dimension of the array A.  LDA >= max(1,N).
  47. *
  48. *  IPIV    (input) INTEGER array, dimension (N)
  49. *          The pivot indices from DGETRF; for 1<=i<=N, row i of the
  50. *          matrix was interchanged with row IPIV(i).
  51. *
  52. *  B       (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
  53. *          On entry, the right hand side matrix B.
  54. *          On exit, the solution matrix X.
  55. *
  56. *  LDB     (input) INTEGER
  57. *          The leading dimension of the array B.  LDB >= max(1,N).
  58. *
  59. *  INFO    (output) INTEGER
  60. *          = 0:  successful exit
  61. *          < 0:  if INFO = -i, the i-th argument had an illegal value
  62. *
  63. *  =====================================================================
  64. *
  65. *     .. Parameters ..
  66.       DOUBLE PRECISION   ONE
  67.       PARAMETER          ( ONE = 1.0D+0 )
  68. *     ..
  69. *     .. Local Scalars ..
  70.       LOGICAL            NOTRAN
  71. *     ..
  72. *     .. External Functions ..
  73.       LOGICAL            LSAME
  74.       EXTERNAL           LSAME
  75. *     ..
  76. *     .. External Subroutines ..
  77.       EXTERNAL           DLASWP, DTRSM, XERBLA
  78. *     ..
  79. *     .. Intrinsic Functions ..
  80.       INTRINSIC          MAX
  81. *     ..
  82. *     .. Executable Statements ..
  83. *
  84. *     Test the input parameters.
  85. *
  86.       INFO = 0
  87.       NOTRAN = LSAME( TRANS, 'N' )
  88.       IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
  89.      $    LSAME( TRANS, 'C' ) ) THEN
  90.          INFO = -1
  91.       ELSE IF( N.LT.0 ) THEN
  92.          INFO = -2
  93.       ELSE IF( NRHS.LT.0 ) THEN
  94.          INFO = -3
  95.       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
  96.          INFO = -5
  97.       ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
  98.          INFO = -8
  99.       END IF
  100.       IF( INFO.NE.0 ) THEN
  101.          CALL XERBLA( 'DGETRS', -INFO )
  102.          RETURN
  103.       END IF
  104. *
  105. *     Quick return if possible
  106. *
  107.       IF( N.EQ.0 .OR. NRHS.EQ.0 )
  108.      $   RETURN
  109. *
  110.       IF( NOTRAN ) THEN
  111. *
  112. *        Solve A * X = B.
  113. *
  114. *        Apply row interchanges to the right hand sides.
  115. *
  116.          CALL DLASWP( NRHS, B, LDB, 1, N, IPIV, 1 )
  117. *
  118. *        Solve L*X = B, overwriting B with X.
  119. *
  120.          CALL DTRSM( 'Left', 'Lower', 'No transpose', 'Unit', N, NRHS,
  121.      $               ONE, A, LDA, B, LDB )
  122. *
  123. *        Solve U*X = B, overwriting B with X.
  124. *
  125.          CALL DTRSM( 'Left', 'Upper', 'No transpose', 'Non-unit', N,
  126.      $               NRHS, ONE, A, LDA, B, LDB )
  127.       ELSE
  128. *
  129. *        Solve A' * X = B.
  130. *
  131. *        Solve U'*X = B, overwriting B with X.
  132. *
  133.          CALL DTRSM( 'Left', 'Upper', 'Transpose', 'Non-unit', N, NRHS,
  134.      $               ONE, A, LDA, B, LDB )
  135. *
  136. *        Solve L'*X = B, overwriting B with X.
  137. *
  138.          CALL DTRSM( 'Left', 'Lower', 'Transpose', 'Unit', N, NRHS, ONE,
  139.      $               A, LDA, B, LDB )
  140. *
  141. *        Apply row interchanges to the solution vectors.
  142. *
  143.          CALL DLASWP( NRHS, B, LDB, 1, N, IPIV, -1 )
  144.       END IF
  145. *
  146.       RETURN
  147. *
  148. *     End of DGETRS
  149. *
  150.       END
  151.